home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / ActiveX Controlls / XP Suite / DATA1.CAB / XP_Panel_Sample_Files / modDeclares.bas < prev    next >
Encoding:
BASIC Source File  |  2003-04-24  |  16.1 KB  |  412 lines
  1. Attribute VB_Name = "modDeclares"
  2. Option Explicit
  3.  
  4. Public Const HKEY_CLASSES_ROOT = &H80000000
  5. 'Public Const KEY_ALL_ACCESS = &H2003F
  6. Public Const hNull& = 0
  7. Public Const MAX_PATH = 260
  8. Public Const NOERROR = 0
  9. ' Difference between day zero for VB dates and Win32 dates
  10. ' (or #12-30-1899# - #01-01-1601#)
  11. Private Const rDayZeroBias As Double = 109205#    ' Abs(CDbl(#01-01-1601#))
  12. ' 10000000 nanoseconds * 60 seconds * 60 minutes * 24 hours / 10000
  13. ' comes to 86400000 (the 10000 adjusts for fixed point in Currency)
  14. Private Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#
  15.  
  16. Public Const LVM_FIRST = &H1000
  17. Public Const LVS_SHAREIMAGELISTS = &H40&
  18. Public Const GWL_STYLE = (-16)
  19. Public Const LVM_SETIMAGELIST = (LVM_FIRST + 3)
  20. 'Public Const LVSIL_NORMAL = 0
  21. 'Public Const LVSIL_SMALL = 1
  22. Public Const LVIF_IMAGE = &H2
  23. Public Const LVM_SETITEM = (LVM_FIRST + 6)
  24.  
  25. 'Public Const LARGE_ICON As Integer = 32
  26. 'Public Const SMALL_ICON As Integer = 16
  27. 'Public Const ILD_TRANSPARENT = &H1                                     'Display transparent
  28. 'ShellInfo Flags
  29. 'Public Const SHGFI_DISPLAYNAME = &H200
  30. 'Public Const SHGFI_EXETYPE = &H2000
  31. Public Const SHGFI_SYSICONINDEX = &H4000                               'System icon index
  32. 'Public Const SHGFI_LARGEICON = &H0                                     'Large icon
  33. Public Const SHGFI_SMALLICON = &H1                                     'Small icon
  34. 'Public Const SHGFI_SHELLICONSIZE = &H4
  35. 'Public Const SHGFI_TYPENAME = &H400
  36. 'Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
  37. '        Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
  38. '        Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
  39. Public Const SMALLSYS_SHGFI_FLAGS = SHGFI_SYSICONINDEX Or SHGFI_SMALLICON
  40.  
  41. Public Const YMDHMS As String = "yyyymmddhhnnss"
  42. Public Const HMS As String = "hhnnss"
  43. '----------------------------------
  44. Public Const ico_ As String = "ico"
  45. Public Const chk_ As String = "chk"
  46. Public Const nam_ As String = "nam"
  47. Public Const ext_ As String = "ext"
  48. Public Const siz_ As String = "siz"
  49. Public Const typ_ As String = "typ"
  50. Public Const mod_ As String = "mod"
  51. Public Const tim_ As String = "tim"
  52. Public Const cre_ As String = "cre"
  53. Public Const acc_ As String = "acc"
  54. Public Const atr_ As String = "atr"
  55. Public Const dos_ As String = "dos"
  56. '----------------------------------
  57. Public Const cmp_ As String = "cmp"
  58. Public Const rat_ As String = "rat"
  59. Public Const crc_ As String = "crc"
  60. Public Const enc_ As String = "enc"
  61. Public Const mtd_ As String = "mtd"
  62. Public Const pth_ As String = "pth"
  63. Public Const com_ As String = "com"
  64. Public Const sig_ As String = "sig"
  65. '----------------------------------
  66. Public Const ace_      As String = "ace"
  67. Public Const cab_      As String = "cab"
  68. Public Const rar_      As String = "rar"
  69. Public Const zip_      As String = "zip"
  70. Public Const stardot   As String = "*."
  71. '----------------------------------
  72. Public Buffer As String * MAX_PATH
  73. Public f_Type As String * 80
  74.  
  75. Type SHFILEINFO
  76.         hIcon As Long                      '  out: icon
  77.         iIcon As Long                      '  out: icon index
  78.         dwAttributes As Long               '  out: SFGAO_ flags
  79.         szDisplayName As String * MAX_PATH '  out: display name (or path)
  80.         szTypeName As String * 80          '  out: type name
  81. End Type
  82. Public SFI As SHFILEINFO
  83. Public Const cbSFI As Long = 12 + MAX_PATH + 80 'size of SFI
  84.  
  85. Public Type LV_ITEM
  86.     mask As Long
  87.     iItem As Long
  88.     iSubItem As Long
  89.     state As Long
  90.     stateMask As Long
  91.     pszText As String
  92.     cchTextMax As Long
  93.     iImage As Long
  94.     lParam As Long '(~ ItemData)
  95. '#if (_WIN32_IE >= 0x0300)
  96.     iIndent As Long
  97. '#End If
  98. End Type
  99.  
  100.    Public lvi As LV_ITEM 'api list item struc
  101.  
  102.  
  103. 'Modified for Faster Date Conversion & 64-bit NTFS Filesizes
  104. Public Type WIN32_FIND_DATA
  105.    dwFileAttributes  As Long
  106.    ftCreationTime    As Currency
  107.    ftLastAccessTime  As Currency
  108.    ftLastWriteTime   As Currency
  109.    nFileSizeBig      As Currency
  110.    dwReserved0       As Long
  111.    dwReserved1       As Long
  112.    cFileName         As String * 260
  113.    cAlternate        As String * 14
  114. End Type
  115.  
  116. Public Type Master
  117.    GridFormat  As Long
  118.    Index       As Long
  119.    Filename    As String
  120.    Size        As Long
  121.    CompSize    As Long
  122.    Modified    As Date
  123.    Created     As Date
  124.    Accessed    As Date
  125.    Attr        As Long
  126.    Method      As Long
  127.    flags       As Long
  128.    Encypted    As Boolean
  129.    Crc         As Long
  130.    Sig         As Long
  131.    Path        As String
  132.    Comments    As String
  133. End Type
  134. Public Master As Master
  135. Public Type FTs
  136.    Ext As String
  137.    Type As String
  138.    IconIndex As Long
  139. End Type
  140. Public Enum GridFormat
  141.    gfFiles = 1
  142.    gfFtp = 2
  143.    gfCab = 4
  144.    gface = 8
  145.    gfrar = 16
  146.    gfzip = 32
  147. End Enum
  148. Public Enum SHFolders
  149.     CSIDL_DESKTOP = &H0
  150.     CSIDL_INTERNET = &H1
  151.     CSIDL_PROGRAMS = &H2
  152.     CSIDL_CONTROLS = &H3
  153.     CSIDL_PRINTERS = &H4
  154.     CSIDL_PERSONAL = &H5
  155.     CSIDL_FAVORITES = &H6
  156.     CSIDL_STARTUP = &H7
  157.     CSIDL_RECENT = &H8
  158.     CSIDL_SENDTO = &H9
  159.     CSIDL_BITBUCKET = &HA
  160.     CSIDL_STARTMENU = &HB
  161.     CSIDL_DESKTOPDIRECTORY = &H10
  162.     CSIDL_DRIVES = &H11
  163.     CSIDL_NETWORK = &H12
  164.     CSIDL_NETHOOD = &H13
  165.     CSIDL_FONTS = &H14
  166.     CSIDL_TEMPLATES = &H15
  167.     CSIDL_COMMON_STARTMENU = &H16
  168.     CSIDL_COMMON_PROGRAMS = &H17
  169.     CSIDL_COMMON_STARTUP = &H18
  170.     CSIDL_COMMON_DESKTOPDIRECTORY = &H19
  171.     CSIDL_APPDATA = &H1A
  172.     CSIDL_PRINTHOOD = &H1B
  173.     CSIDL_ALTSTARTUP = &H1D '// DBCS
  174.     CSIDL_COMMON_ALTSTARTUP = &H1E '// DBCS
  175.     CSIDL_COMMON_FAVORITES = &H1F
  176.     CSIDL_INTERNET_CACHE = &H20
  177.     CSIDL_COOKIES = &H21
  178.     CSIDL_HISTORY = &H22
  179. End Enum
  180. 'NOTE!! Some declares changed to 'As Any' to
  181. '       accomodate Currency as well as Filetime
  182. Declare Function DosDateTimeToFileTime Lib "kernel32" (ByVal wFatDate As Long, ByVal wFatTime As Long, lpFileTime As Any) As Long
  183. Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  184. 'Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  185. Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  186. Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  187. Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  188. Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  189. Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  190. 'Declare Function GetLogicalDrives Lib "kernel32" () As Long
  191. Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Any, lpLocalFileTime As Any) As Long
  192. Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  193. Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  194. Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  195. Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  196. Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  197. Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hInstance As Long, ByVal uID As Long, ByVal lpBuffer As String, ByVal nBufferMax As Long) As Long
  198. Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  199. Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
  200. Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
  201. 'Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, ByVal i&, ByVal hDCDest&, ByVal x&, ByVal y&, ByVal flags&) As Long
  202. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  203. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  204. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  205. Declare Function GetTickCount Lib "kernel32" () As Long
  206. Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
  207. Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  208. Declare Function CharLower Lib "user32" Alias "CharLowerA" (ByVal lpsz As String) As Long
  209. Declare Function CharUpper Lib "user32" Alias "CharUpperA" (ByVal lpsz As String) As Long
  210. 'Declare Function SHGetMalloc Lib "shell32" (ppMalloc As IMalloc) As Long
  211. Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
  212. Declare Function lstrlenptr Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
  213. Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
  214. Private Declare Sub CopyMemoryLpToStr Lib "kernel32" Alias "RtlMoveMemory" ( _
  215.     ByVal lpvDest As String, lpvSource As Long, ByVal cbCopy As Long)
  216.  
  217. Public Function PointerToString(lPtr As Long) As String
  218. Dim lLen As Long
  219. Dim sR As String
  220.     ' Get length of Unicode string to first null
  221.     lLen = lstrlenptr(lPtr)
  222.     ' Allocate a string of that length
  223.     sR = String$(lLen, 0)
  224.     ' Copy the pointer data to the string
  225.     CopyMemoryLpToStr sR, ByVal lPtr, lLen
  226.     PointerToString = sR
  227. End Function
  228. Public Function QualifyPath(ByVal MyString As String) As String
  229.    If Right$(MyString, 1) <> "\" Then
  230.       QualifyPath = MyString & "\"
  231.    Else
  232.       QualifyPath = MyString
  233.    End If
  234. End Function
  235. Public Function GetMyDate(ZipDate As Integer, ZipTime As Integer) As Date
  236.     Dim FTime As Currency 'Makes it much easier to convert
  237.     'Convert the dos stamp into a file time
  238.     DosDateTimeToFileTime CLng(ZipDate), CLng(ZipTime), FTime
  239.     'Filetime to VbDate
  240.     GetMyDate = UTCCurrToVbDate(FTime, False)
  241. End Function
  242. Public Function GetResourceStringFromFile(sModule As String, idString As Long) As String
  243.  
  244.    Dim hModule As Long
  245.    Dim nChars As Long
  246.  
  247.    hModule = LoadLibrary(sModule)
  248.    If hModule Then
  249.       nChars = LoadString(hModule, idString, Buffer, MAX_PATH)
  250.       If nChars Then
  251.          GetResourceStringFromFile = Left$(Buffer, nChars)
  252.       End If
  253.       FreeLibrary hModule
  254.    End If
  255. End Function
  256.  
  257. Public Function ErrMsgBox(Msg As String) As Integer
  258.     ErrMsgBox = MsgBox("Error: " & Err.Number & ". " & Err.Description, vbRetryCancel + vbCritical, Msg)
  259. End Function
  260. Public Function UTCCurrToVbDate(ByVal MyCurr As Currency, Optional TooLocal As Boolean = True) As Date
  261.    Dim UTC As Currency
  262.    ' Discrepancy in WIN32_FIND_DATA:
  263.    ' Win2000 correctly reports 0 as 01-01-1980, Win98/ME does not.
  264.    If MyCurr = 0 Then MyCurr = 11960017200000# ' 01-01-1980
  265.    If TooLocal Then
  266.       FileTimeToLocalFileTime MyCurr, UTC
  267.    Else
  268.       UTC = MyCurr
  269.    End If
  270.    UTCCurrToVbDate = (UTC / rMillisecondPerDay) - rDayZeroBias
  271.  
  272. End Function
  273. Public Function CVC(ByVal Big As Currency) As Currency
  274.     'Swap High/Low of Big
  275.     'NOTE: Stores value as 64-bit integer (up to 8 Exabytes - 1)
  276.     '      Scale * 10000 when retrieving value (VbCurrency)
  277.     CopyMemory ByVal VarPtr(CVC) + 4, Big, 4
  278.     CopyMemory CVC, ByVal VarPtr(Big) + 4, 4
  279. End Function
  280. Public Function DirSpace(sPath As String) As Currency
  281.    Dim Win32Fd As WIN32_FIND_DATA
  282.    Dim lHandle As Long
  283.    Const FILE_ATTRIBUTE_DIRECTORY = &H10
  284.    sPath = QualifyPath(sPath)
  285.    lHandle = FindFirstFile(sPath & "*.*", Win32Fd)
  286.    If lHandle > 0 Then
  287.       Do
  288.          If Asc(Win32Fd.cFileName) <> 46 Then  'skip . and .. entries
  289.             If (Win32Fd.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
  290.                DirSpace = DirSpace + CVC(Win32Fd.nFileSizeBig)
  291.             Else 'Recurse
  292.                DirSpace = DirSpace + DirSpace(sPath & StripNull(Win32Fd.cFileName))
  293.             End If
  294.          End If
  295.       Loop While FindNextFile(lHandle, Win32Fd) > 0
  296.    End If
  297.    FindClose (lHandle)
  298.  
  299. End Function
  300. Public Sub ParseFullPath(ByVal FullPath As String, JustPath As String, JustName As String)
  301.    
  302.    Dim lSlash As Integer
  303.    
  304.    ' Given a full path, parse it and return
  305.    ' the path and file name.
  306.    lSlash = InStrRev(FullPath, "/")
  307.    If lSlash = 0 Then
  308.       lSlash = InStrRev(FullPath, "\")
  309.    End If
  310.    If lSlash > 0 Then
  311.       JustName = Mid$(FullPath, lSlash + 1)
  312.       JustPath = Left$(FullPath, lSlash)
  313.    Else
  314.       JustName = FullPath
  315.       JustPath = ""
  316.    End If
  317.  
  318. End Sub
  319. Public Function StringToPointer(sStr As String, ByRef ByteArray() As Byte) As Long
  320.     Dim x As Long
  321.     Dim lstrlen As Long
  322.     
  323.     lstrlen = Len(sStr)
  324.     For x = 1 To lstrlen
  325.         ByteArray(x - 1) = AscB(Mid(sStr, x, 1))
  326.     Next
  327.     ByteArray(x - 1) = 0
  328.     StringToPointer = VarPtr(ByteArray(LBound(ByteArray)))
  329. End Function
  330. Public Function StripNull(ByVal StrIn As String) As String
  331.    On Error GoTo ProcedureError
  332.    Dim nul As Long
  333.    '
  334.    ' Truncate input string at first null.
  335.    ' If no nulls, perform ordinary Trim.
  336.    '
  337.    nul = InStr(StrIn, vbNullChar)
  338.    Select Case nul
  339.       Case Is > 1
  340.          StripNull = Left$(StrIn, nul - 1)
  341.       Case 1
  342.          StripNull = ""
  343.       Case 0
  344.          StripNull = Trim$(StrIn)
  345.    End Select
  346.  
  347. ProcedureExit:
  348.   Exit Function
  349. ProcedureError:
  350.      If ErrMsgBox("mDeclares.StripNull") = vbRetry Then Resume Next
  351.  
  352.  
  353. End Function
  354. Public Function FolderLocation(lFolder As SHFolders) As String
  355.  
  356.    Dim lp As Long
  357.    'Get the PIDL for this folder
  358.    SHGetSpecialFolderLocation 0&, lFolder, lp
  359.    SHGetPathFromIDList lp, Buffer
  360.    FolderLocation = StripNull(Buffer)
  361.    'Free the PIDL
  362.    CoTaskMemFree lp
  363.  
  364. End Function
  365. Public Function FormatSize(ByVal Size As Variant) As String
  366.    'Handles up to 999.9 Yottabytes.
  367.  
  368.    'MB = 1024 ^ 2 'Megabyte  2^20 or 1048576
  369.    'GB = 1024 ^ 3 'Gigabyte  2^30 or 1073741824
  370.    'TB = 1024 ^ 4 'Terabyte  2^40 or 1099511627776
  371.    'PB = 1024 ^ 5 'Petabyte  2^50 or 1125899906842624
  372.    'EB = 1024 ^ 5 'Exabyte   2^60 or 1152921504606846976
  373.    'ZB = 1024 ^ 6 'Zettabyte 2^70 or 1180591620717411303424
  374.    'YB = 1024 ^ 7 'Yottabyte 2^80 or 1208925819614629174706176
  375.    'Formats as:
  376.    '   #.###
  377.    'or ##.##
  378.    'or ###.#
  379.    Dim Decimals As Integer, Group As Integer, Pwr As Integer
  380.    Dim SizeKb
  381.    Const KB& = 1024
  382.    On Error GoTo PROC_ERR
  383.  
  384.    If Size < KB Then 'Return bytes
  385.       FormatSize = FormatNumber(Size, 0) & " b"
  386.       ' Vb5 FormatSize = Format(Size, "#,##0 b")
  387.    Else
  388.       SizeKb = Size / KB
  389.       For Pwr = 0 To 23
  390.          If SizeKb < 10 ^ (Pwr + 1) Then    ' Fits our criteria
  391.             Group = Pwr \ 3                 ' Kb(0), Mb(1), etc.
  392.             SizeKb = SizeKb / KB ^ Group    ' Scale to group
  393.             Decimals = 4 - Len(Int(SizeKb)) ' NumDigitsAfterDecimal
  394.             FormatSize = FormatNumber(SizeKb, Decimals) & " " & _
  395.                          Mid("KMGTPEZY", Group + 1, 1) & "b"
  396.             ' Vb5 FormatSize = Format(SizeKb, "#,###." & String(Decimals, 48)) & " " & _
  397.                          Mid("KMGTPEZY", Group + 1, 1) & "b"
  398.             Exit For
  399.          End If
  400.       Next
  401.       If FormatSize = "" Then FormatSize = "Out of bounds"
  402.    End If
  403.     
  404. PROC_EXIT:
  405.   Exit Function
  406. PROC_ERR:
  407.    FormatSize = "Overflow"
  408. End Function
  409.  
  410.  
  411.  
  412.